home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / INDECO.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  14.8 KB  |  390 lines
  1.       SUBROUTINE INDECO 
  2. *-----------------------------------------------------------------------
  3. *   
  4. * Complete processing of user commands on input.
  5. * The input is received from routine INUSER.
  6. * The output is stored in commons  /FLAGS/, /KEYINP/, and /SKEYNP/  
  7. *   
  8. *-----------------------------------------------------------------------
  9.       include 'PARAM.h' 
  10.       include 'ALCAZA.h' 
  11.       include 'STATE.h' 
  12.       include 'KEYCOM.h' 
  13.       include 'FLAGS.h' 
  14.       include 'FLWORK.h' 
  15.       include 'CLASS.h' 
  16.       include 'CONDEC.h' 
  17. *   
  18.       DIMENSION NSUBKY(MTOTKY),KSUBKY(MTOTKY),KDEFKY(MTOTKY), KACTKY
  19.      +(MTOTKY),KLISKY(MTOTKY),KKEYLS(MTOTKY),KKEYLG(MTOTKY), KSUBRF 
  20.      +(MSUBKY),KSUBIX(MSUBKY),KSUBAC(MSUBKY),KSUBLG(MSUBKY), KSUBLS 
  21.      +(MSUBKY),KDEFAU(7,2),IBIT(3)  
  22. *   NSUBKY(I) = # of sub-keys of key I  
  23. *   KSUBKY(I) = start-1 of sub-key list in KSUBRF   
  24. *   KDEFKY(I) = default flag if no sub-key given
  25. *   KACTKY(I) = action flag to be set by key I  
  26. *   KLISKY(I) = cumulative 'type of input' indicator:   
  27. *               1   integer list given  
  28. *               2   name list given 
  29. *               4   string list given   
  30. *   KKEYLS(I) = for key I, ref. to KDEFAU for numerical default values  
  31. *   KKEYLG(I) = for key I, no. of numerical default values in KDEFAU
  32. *   KSUBRF    = ref. list of sub-keys   
  33. *   KSUBIX(J) = for sub-key number J, 'type of action' indicator:   
  34. *               -2   insert list of non-executable statements   
  35. *               -1   insert list of executable statements   
  36. *               > 0: p, where p is the position of the first integer
  37. *               behind the sub-key of the integer list (FORMAT=... etc.)
  38. *   KSUBLG(J) = for sub-key number J, no. of words for default values   
  39. *   KSUBAC(J) = for sub-key number J, action flag to be set, or zero
  40. *   KSUBLS(J) = for sub-key J, ref. to default integer list 
  41. *   KDEFAU(I,J) = for above ref., defaults  
  42. *   IBIT      = temporary storage for bits from KLISKY  
  43.       CHARACTER*3 STRKEY(MTOTKY),SUBKEY(MSUBKY) 
  44. *    STRKEY = list of keys  
  45. *   SUBKEY = list of sub-keys   
  46.       CHARACTER STEMP*1,STEMP3*3,SLNAM*(MXNMCH) 
  47.       DATA STRKEY/'OR;','END','PRI','LIS','OUT','FIR','STA','OPT', 'REP'
  48.      +,'ROU','NAM','STR','CLA'/ 
  49.       DATA SUBKEY/'CHA','END','FOR','FUL','GLO','ILL','IND','NUM', 'QUO'
  50.      +,'RET','SEP','EXE','NEX','PAR','CHA','PAR','FUL','SEP', 'TYP',
  51.      +'USE','COM','COM','GOT','TRE'/
  52.       DATA NSUBKY/0,0,4,3,4,0,6,5,0,0,0,0,2/
  53.       DATA KSUBKY/0,0,0,4,7,11,11,17,22,22,22,22,22/
  54.       DATA KDEFKY/0,0,5,1,8,0,0,0,0,0,0,0,0/
  55.       DATA KACTKY/0,0,0,0,0,10,13,0,0,16,18,19,17/  
  56.       DATA KLISKY/0,0,0,0,0,0,0,0,6,2,2,4,1/
  57.       DATA KKEYLS/6*0,1,6*0/
  58.       DATA KKEYLG/6*0,7,6*0/
  59.       DATA KSUBRF/1,4,6,14,5,11,19,15,16,17,21,2,3,8,10,18,23,24,7,9,   
  60.      +20,22,12,13/  
  61.       DATA KSUBIX/0,7,3,0,0,0,1,1,2,5,0,-1,-2,8*0,3,2*0/
  62.       DATA KSUBLG/0,7,7,0,0,0,3,7,3,7,11*0,3,2*0/   
  63.       DATA KSUBAC/4,0,0,6,2,3,21,0,11,0,1,0,0,5,7,8,9,14,20,22,23,27,   
  64.      +28,29/
  65.       DATA KSUBLS/0,0,0,0,0,0,2,0,2,12*0,2,2*0/ 
  66. *--- in KDEFAU, under 1:
  67. *    defaults for statement numbers(2),formats(2),returns(2),end(1) 
  68. *    under 2: defaults for INDFAC (1), and IBLPAD (1)   
  69.       DATA KDEFAU/10,10,0,10,0,1,0, 3,1,0,4*0/  
  70.     
  71. *   
  72.       include 'CONDAT.h' 
  73. *--- read all input commands, pre-process, store in SIMA
  74.       CALL INUSER   
  75. *--- check for illegal keys 
  76.       IPR=0 
  77.       DO 20 IS=1,NSTAMM 
  78.          STEMP3=SIMA(NFLINE(IS))(1:3)   
  79.          DO 10 IC=1,MTOTKY  
  80.             IF (STEMP3.EQ.STRKEY(IC)) GOTO 20   
  81.    10    CONTINUE   
  82.          WRITE (MPUNIT,10020) STEMP3
  83.          IF (IPR.EQ.0)  THEN
  84.             WRITE (MPUNIT,10030) STRKEY 
  85.             IPR=1   
  86.          ENDIF  
  87.    20 CONTINUE  
  88. *--- start decoding 
  89.       NKEY=0
  90. *--- loop over global (IORSET=0) and local keys 
  91.       DO 160 IORSET=0,NORSET
  92.          IF (IORSET.EQ.0)  THEN 
  93.             ILOW=3  
  94.             IUP=MGLOKY  
  95.             I1=1
  96.             I2=NSTAMM   
  97.          ELSE   
  98.             ILOW=MGLOKY+1   
  99.             IUP=MTOTKY  
  100.          ENDIF  
  101.          DO 150 IKY=ILOW,IUP
  102.             NSINT=0 
  103.             NFINT=0 
  104.             IF (IORSET.NE.0)  THEN  
  105.                I1=NSSTRT(IORSET)
  106.                I2=NSEND(IORSET) 
  107.             ENDIF   
  108. *--- collect all occurences (either globally, or in this OR-set)
  109. *    of this key
  110.             CALL INEXTR(STRKEY(IKY),I1,I2,NL)   
  111. *--- complete key now in SSTA, length NL (characters), cleaned  
  112. *    from key-words.
  113.             IF (NL.LT.0) GOTO 150   
  114. *--- set bit string for integer list etc.   
  115.             N=KLISKY(IKY)   
  116.             DO 30 J=3,1,-1  
  117.                IBIT(J)=N/2**(J-1)   
  118.                N=N-IBIT(J)*2**(J-1) 
  119.    30       CONTINUE
  120. *--- count  
  121.             IF (IORSET.EQ.0)  THEN  
  122.                NGLSET=NGLSET+1  
  123.             ELSE
  124.                IF (NORCOM(IORSET).EQ.0) KORCOM(IORSET)=NKEY 
  125.                NORCOM(IORSET)=NORCOM(IORSET)+1  
  126.             ENDIF   
  127.             NKEY=NKEY+1 
  128.             KEYREF(NKEY,1)=IKY  
  129. *--- set action flags   
  130.             IF (KACTKY(IKY).NE.0)  THEN 
  131.                ACTION(KACTKY(IKY))=.TRUE.   
  132.             ENDIF   
  133. *--- defaults for keys  
  134.             IF (KKEYLS(IKY).GT.0.AND.KEYREF(NKEY,2).EQ.0)  THEN 
  135.                NKS=KKEYLG(IKY)  
  136.                KEYREF(NKEY,2)=NKS   
  137.                KEYREF(NKEY,3)=NKYINT
  138.                KK=KKEYLS(IKY)   
  139.                DO 40 JJ=1,NKS   
  140.                   NKYINT=NKYINT+1   
  141.                   KEYINT(NKYINT)=KDEFAU(JJ,KK)  
  142.    40          CONTINUE 
  143.             ENDIF   
  144. *--- sub-keys   
  145.             NSFD=0  
  146.             DO 80 JS=1,NSUBKY(IKY)  
  147.                JSC=KSUBKY(IKY)+JS   
  148.                JSN=KSUBRF(JSC)  
  149.                IF(NL.EQ.0)  THEN
  150.                   IND=0 
  151.                ELSE 
  152.                   IND=INDEX(SSTA(:NL),SUBKEY(JSN))  
  153.                ENDIF
  154.                IF (IND.GT.0)  THEN  
  155. *--- sub-key found  
  156.                   NSFD=1
  157.                   CALL SKIPTP(2,SSTA,IND,NL,.FALSE.,JPT,ILEV)   
  158.                   IF (KSUBIX(JSN).GT.0)  THEN   
  159. *--- integers following 
  160.                      IF (KEYREF(NKEY,2).EQ.0)  THEN 
  161. *--- get length and reserve space   
  162.                         NKS=KSUBLG(JSN) 
  163.                         KEYREF(NKEY,2)=NKS  
  164.                         KEYREF(NKEY,3)=NKYINT   
  165. *--- set default values 
  166.                         KK=KSUBLS(JSN)  
  167.                         DO 50 JJ=1,NKS  
  168.                            NKYINT=NKYINT+1  
  169.                            KEYINT(NKYINT)=KDEFAU(JJ,KK) 
  170.    50                   CONTINUE
  171.                      ENDIF  
  172. *--- integer position   
  173.                      IPOS=KSUBIX(JSN)   
  174.    60                CONTINUE   
  175.                      CALL GETNBL(SSTA(JPT+1:NL),STEMP,N)
  176.                      IF(N.GT.0.AND.(STEMP.EQ.'='
  177.      +               .OR.NUMCH(STEMP)))  THEN   
  178. *--- next comma position
  179.                         JCOM=JPT+INDEX(SSTA(JPT+1:NL),',')  
  180.                         IF(JCOM.EQ.JPT) JCOM=NL 
  181. *--- get integer
  182.                         CALL GETINT(SSTA,JPT,JCOM,KFCH,KLCH,NN) 
  183.                         IF (KFCH.GT.0) THEN 
  184. *--- integer found  
  185.                            IF(NN.GT.0) KEYINT(KEYREF(NKEY,3)+IPOS)=NN   
  186.                            IPOS=IPOS+1  
  187.                            JPT=JCOM 
  188.                            IF (IPOS.LE.NKS) GOTO 60 
  189.                         ENDIF   
  190.                      ENDIF  
  191.                   ELSEIF(KSUBIX(JSN).LT.0)  THEN
  192. *--- EXE or NEX, add corresponding classes  
  193.                      NTYP=KSUBIX(JSN)+2 
  194. *--- collect in IWS first   
  195.                      DO 70 JCL=1,NCLASS 
  196.                         IF (ISTMDS(11,JCL).EQ.NTYP)  THEN   
  197.                            NSINT=NSINT+1
  198.                            IWS(NSINT)=ISTMDS(6,JCL) 
  199.                         ENDIF   
  200.    70                CONTINUE   
  201.                   ENDIF 
  202.                   IF (KSUBAC(JSN).GT.0)  THEN   
  203. *--- action flag
  204.                      ACTION(KSUBAC(JSN))=.TRUE. 
  205.                   ENDIF 
  206.                ENDIF
  207. *--- end of sub-key loop
  208.    80       CONTINUE
  209.             IF (NSFD.EQ.0)  THEN
  210. *--- no sub-key found - set default flag if any 
  211.                IF (KDEFKY(IKY).GT.0) ACTION(KDEFKY(IKY))=.TRUE. 
  212.             ENDIF   
  213. *--- get integers if any
  214.             IF (IBIT(1).NE.0)  THEN 
  215.                JPT=0
  216.                KADD=0   
  217.    90          CONTINUE 
  218.                CALL GETINT(SSTA,JPT+1,NL,KFCH,KLCH,NN)  
  219.                IF (KFCH.GT.0)  THEN 
  220. *--- integer found  
  221.                   JPT=KLCH  
  222.                   IF (KADD.EQ.0)  THEN  
  223.                      NSINT=NSINT+1  
  224.                      IWS(NSINT)=NN  
  225.                   ELSE  
  226.                      NFINT=NFINT+1  
  227.                      IWS(KADD+NFINT)=NN 
  228.                   ENDIF 
  229.                   IF (JPT.LT.NL)  THEN  
  230. *--- store those after IF ref. separately   
  231.                      IF (SSTA(JPT+1:JPT+1).EQ.'('.AND.KADD.EQ.0.AND.
  232.      +               ISTMDS(6,IIF).EQ.NN) THEN  
  233.                         KADD=MXKINT 
  234.                      ELSEIF (SSTA(JPT+1:JPT+1).EQ.')')  THEN
  235.                         KADD=0  
  236.                      ENDIF  
  237.                      GOTO 90
  238.                   ENDIF 
  239.                ENDIF
  240. *--- store integers (classes),in the following way: 
  241. *  # of simple, plus those following, # of classes behind IF,   
  242. *  plus those following 
  243.                IF (NSINT.GT.0)  THEN
  244.                   KEYREF(NKEY,3)=NKYINT 
  245. *--- sort and suppress multiples
  246.                   CALL SORTSP(NSINT,IWS,N)  
  247.                   KEYINT(NKYINT+1)=N
  248.                   DO 100 J=1,N  
  249.                      KEYINT(NKYINT+J+1)=IWS(J)  
  250.   100             CONTINUE  
  251.                   CALL SORTSP(NFINT,IWS(MXKINT+1),NN)   
  252.                   KEYINT(NKYINT+N+2)=NN 
  253.                   DO 110 J=1,NN 
  254.                      KEYINT(NKYINT+N+J+2)=IWS(MXKINT+J) 
  255.   110             CONTINUE  
  256.                   KEYREF(NKEY,2)=N+NN+2 
  257.                   NKYINT=NKYINT+KEYREF(NKEY,2)  
  258.                ENDIF
  259.             ENDIF   
  260. *--- get names if any   
  261.             IF (IBIT(2).NE.0)  THEN 
  262.                IPT=0
  263.   120          CONTINUE 
  264. *--- find name outside string   
  265.                CALL GETNAM(SSTA,IPT+1,NL,KFCH,KLCH) 
  266.                IF (KFCH.GT.0)  THEN 
  267. *--- name found 
  268.                   IF (KEYREF(NKEY,4).EQ.0) KEYREF(NKEY,5)=NKYNAM
  269.                   IF (NKYNAM.EQ.MXKNAM)  THEN   
  270.                      WRITE (MPUNIT,10000) NKYNAM
  271.                      GOTO 150   
  272.                   ENDIF 
  273.                   SLNAM='        '  
  274.                   SLNAM(:KLCH+1-KFCH)=SSTA(KFCH:KLCH)   
  275.                   IPT=KLCH  
  276. *--- enter name in table (alphabetic for each key)  
  277.                   K=KEYREF(NKEY,5)  
  278.                   CALL NAMTAB(SLNAM,SKEYLS(K+1),NKYNAM-K,IPOS)  
  279.                   IF (IPOS.GT.0)  THEN  
  280. *--- name has been entered in table (otherwise already in)  
  281.                      IPOS=IPOS+K
  282.                      DO 130 JJ=1,2  
  283.                         DO 130 J=NKYNAM,IPOS,-1 
  284.                            KNAMRF(J+1,JJ)=KNAMRF(J,JJ)  
  285.   130                CONTINUE   
  286.                      NKYNAM=NKYNAM+1
  287.                      KEYREF(NKEY,4)=KEYREF(NKEY,4)+1
  288.                      KNAMRF(IPOS,1)=0   
  289.                      KNAMRF(IPOS,2)=0   
  290.                   ENDIF 
  291. *--- check for string following if any  
  292.                   IF (IBIT(3).NE.0)  THEN   
  293.                      IF (SSTA(IPT+1:IPT+1).EQ.'{')  THEN
  294. *--- delete string indicator (for string scan later on) 
  295.                         SSTA(IPT+1:IPT+1)=' '   
  296.                         IND=INDEX(SSTA(IPT+1:NL),'}')   
  297.                         IF (IND.GT.2.AND.IPOS.GT.0)  THEN   
  298.                            CALL INDECS(IPT+1,IPT+IND,*150)  
  299.                            KNAMRF(IPOS,1)=NKYSTR
  300.                         ENDIF   
  301.                         IPT=IPT+MAX(IND,1)  
  302.                      ENDIF  
  303. *--- look for replacement string
  304.                      IF (IPT+2.LT.NL.AND.SSTA(IPT+1:IPT+2).EQ.'={') 
  305.      +               THEN   
  306.                         IPT=IPT+1   
  307.                         SSTA(IPT+1:IPT+1)=' '   
  308.                         IND=INDEX(SSTA(IPT+1:NL),'}')   
  309.                         IF (IND.GT.2.AND.IPOS.GT.0)  THEN   
  310.                            CALL INDECS(IPT+1,IPT+IND,*150)  
  311.                            KNAMRF(IPOS,2)=NKYSTR
  312.                            ACTION(15)=.TRUE.
  313.                         ENDIF   
  314.                         IPT=IPT+MAX(IND,1)  
  315.                      ENDIF  
  316.                   ENDIF 
  317.                   GOTO 120  
  318.                ENDIF
  319.             ENDIF   
  320. *--- check for strings to be replaced   
  321.             IF (IBIT(3).NE.0)  THEN 
  322.                IPT=0
  323.   140          CONTINUE 
  324.                IND=INDEX(SSTA(IPT+1:NL),'{')
  325.                IF (IND.GT.0)  THEN  
  326.                   IPT=IPT+IND-1 
  327.                   IND=INDEX(SSTA(IPT+1:NL),'}') 
  328.                   IF (IND.GT.2)  THEN   
  329.                      IF (NKYCHR.EQ.MXKNAM)  THEN
  330.                         WRITE (MPUNIT,10010) NKYCHR 
  331.                         GOTO 150
  332.                      ENDIF  
  333.                      CALL INDECS(IPT+1,IPT+IND,*150)
  334.                      IF (KEYREF(NKEY,6).EQ.0) KEYREF(NKEY,7)=NKYCHR 
  335.                      KEYREF(NKEY,6)=KEYREF(NKEY,6)+1
  336.                      NKYCHR=NKYCHR+1
  337.                      KSTREF(NKYCHR,1)=NKYSTR
  338.                   ENDIF 
  339.                   IPT=IPT+MAX(IND,1)
  340. *--- look for replacement string
  341.                   IF (IPT+2.LT.NL.AND.SSTA(IPT+1:IPT+2).EQ.'={')  THEN  
  342.                      IPT=IPT+1  
  343.                      IND=INDEX(SSTA(IPT+1:NL),'}')  
  344.                      IF (IND.GT.2)  THEN
  345.                         CALL INDECS(IPT+1,IPT+IND,*150) 
  346.                         KSTREF(NKYCHR,2)=NKYSTR 
  347.                         ACTION(12)=.TRUE.   
  348.                      ENDIF  
  349.                      IPT=IPT+MAX(IND,1) 
  350.                   ENDIF 
  351.                   GOTO 140  
  352.                ENDIF
  353.             ENDIF   
  354.   150    CONTINUE   
  355.   160 CONTINUE  
  356. *--- look for indentation multiple request  
  357.       INDFAC=0  
  358.       IBLPAD=1  
  359.       DO 170 I=1,NGLSET 
  360.          IF (KEYREF(I,1).EQ.8) GOTO 180 
  361.   170 CONTINUE  
  362.       GOTO 190  
  363.   180 CONTINUE  
  364.       IF(KEYREF(I,2).GT.0)  THEN
  365.          IF(ACTION(21))  INDFAC=MIN(5,KEYINT(KEYREF(I,3)+1))
  366.          IF(ACTION(11))  IBLPAD=MIN(10,KEYINT(KEYREF(I,3)+2))   
  367.          IF(ACTION(27))  ICBPRT=KEYINT(KEYREF(I,3)+3)   
  368.       ENDIF 
  369.   190 CONTINUE  
  370.       ACTION(25)=ACTION(1)  
  371.       ACTION(26)=ACTION(2)  
  372. *--- allow flags and options to be set directly 
  373.       CALL SETREQ   
  374.       ACTION(24)=ACTION(24).OR.ACTION(27).OR.ACTION(29) 
  375.       ACTION(27)=ACTION(27).AND..NOT.ACTION(29) 
  376.       ACTION(3)=ACTION(3).OR.ACTION(6)  
  377. *--- namelist / routine if common block option given, dito type 
  378.       ACTION(1)=ACTION(1).OR.ACTION(24) 
  379.       ACTION(20)=ACTION(20).OR.ACTION(24)   
  380. *--- print flags
  381.       ACTION(5)=ACTION(5).OR.ACTION(6)  
  382.       ACTION(4)=ACTION(4).OR.ACTION(5)  
  383. 10000 FORMAT(/1X,8('*=*='),' WARNING - max. no. of names =', I5,
  384.      +' reached in commands, rest ignored') 
  385. 10010 FORMAT(/1X,8('*=*='),' WARNING - max. no. of strings =', I5,  
  386.      +' reached in commands, rest ignored') 
  387. 10020 FORMAT(/' *=*=*=*= WARNING - illegal key "',A,'" ignored',/)  
  388. 10030 FORMAT(/' valid keys are:'/(1X,10A10))
  389.       END   
  390.